home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / iconp.zip / DELAM.ICN < prev    next >
Text File  |  1987-05-29  |  3KB  |  141 lines
  1. #    DELAM(1)
  2. #
  3. #    Delaminate file using field list
  4. #
  5. #    Thomas R. Hicks
  6. #
  7. #    Last modified 7/10/83
  8. #
  9.  
  10. procedure main(a)
  11.    local inpt, fylist, ranges
  12.    if (not a[1]) | a[1] == "?" then
  13.       Usage()
  14.    else if any('0123456789',a[1]) then
  15.       ranges := fldecode(a[1])
  16.    else
  17.       {
  18.       write(&errout,"Bad argument to delam: ",a[1])
  19.       Usage()
  20.       }
  21.    if not a[2] then
  22.       Usage()
  23.    else if (match("-",a[2])) then
  24.       inpt := &input
  25.        else if not (inpt := open(a[2])) then
  26.          stop("Cannot open ",a[2])
  27.    fylist := doutfyls(a,3)
  28.    if *fylist ~= *ranges then
  29.       stop("Unequal number of field args and output files")
  30.    delamr(inpt,ranges,fylist)
  31. end
  32.  
  33. # Usage - write usage message
  34. #
  35. procedure Usage()
  36.    stop("Usage: delam fieldlist {infile | -} {outputfile | -}...")
  37. end
  38.  
  39. # delamr - do actual division of input file
  40. #
  41. procedure delamr(ifd,ranges,fylist)
  42.    local i, j, k, line
  43.    while line := read(ifd) do
  44.       {
  45.       i := 1
  46.       while i <= *fylist do
  47.          {
  48.          j := ranges[i][1]
  49.          k := ranges[i][2]
  50.          if k > 0 then
  51.             write(fylist[i][2],line[j+:k] | line[j:0] | "")
  52.          i +:= 1
  53.          }
  54.       }
  55. end
  56.  
  57. # doutfyls - process the output file arguments; return list
  58. #
  59. procedure doutfyls(a,i)
  60.    local lst, x
  61.    lst := []
  62.    while \a[i] do
  63.       {
  64.       if x := llu(a[i],lst) then        # already in list
  65.          lst |||:= [[a[i],lst[x][2]]]
  66.       else                    # not in list
  67.          if a[i] == "-" then            # standard out
  68.             lst |||:= [[a[i],&output]]
  69.          else                    # new file
  70.             if not (x := open(a[i],"w")) then
  71.                stop("Cannot open ",a[i]," for output")
  72.             else
  73.                lst |||:= [[a[i],x]]
  74.       i +:= 1
  75.       }
  76.    return lst
  77.  
  78. end
  79.  
  80. # fldecode - decode the fieldlist argument
  81. #
  82. procedure fldecode(fldlst)
  83.    local fld, flst, poslst, m, n, x
  84.    poslst := []
  85.    flst := str2lst(fldlst,':,;')
  86.    every fld := !flst do
  87.       {
  88.       if x := upto('-+',fld) then
  89.          {
  90.          if not (m := integer(fld[1:x])) then
  91.             stop("bad argument in field list; ",fld)
  92.          if not (n := integer(fld[x+1:0])) then
  93.             stop("bad argument in field list; ",fld)
  94.          if upto('-',fld) then
  95.             {
  96.             if n < m then
  97.                n := 0
  98.             else
  99.                n := (n - m) + 1
  100.             }
  101.          }
  102.       else {
  103.          if not (m := integer(fld)) then
  104.             stop("bad argument in field list; ",fld)
  105.          n := 1
  106.          }
  107.       poslst |||:= [[m,n]]
  108.       }
  109.    return poslst
  110. end
  111.  
  112. # llu - lookup file name in output file list
  113. #
  114. procedure llu(str,lst)
  115.    local i
  116.    i := 1
  117.    while \lst[i] do
  118.       {
  119.       if \lst[i][1] == str then
  120.          return i
  121.       i +:= 1
  122.       }
  123. end
  124.  
  125. # str2lst - create a list from a delimited string
  126. #
  127. procedure str2lst(str,delim)
  128.    local lst, f
  129.    lst := []
  130.    str ? {
  131.       while f := (tab(upto(delim))) do
  132.       {
  133.       lst |||:= [f]
  134.       move(1)
  135.       }
  136.         if "" ~== (f := tab(0)) then
  137.         lst |||:= [f]
  138.         }
  139.    return lst
  140. end
  141.